home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbnws202.zip / ASCIIART.ZIP / ASCIIART.BAS next >
BASIC Source File  |  1991-05-08  |  34KB  |  550 lines
  1. 'ASCIIART.BAS  Copyright 1991 by
  2. 'Charles Graham, POB 58634, St. Louis, MO 63158
  3. 'All rights reserved
  4.  
  5. 'FUNCTION dir$, by David Cleary, has been
  6. 'modified for use in this program.
  7.  
  8. 'ASCIIART.BAS displays ASCII (text) files as
  9. 'color images on EGA or color CGA systems.
  10.  
  11. 'To execute properly, QuickBASIC must be
  12. 'invoked with the /l option:  i.e., QB/L.
  13.  
  14. '$INCLUDE: 'qb.bi'                               'Include the QB help
  15.                                                  '  file for interrupts
  16. DEFINT A-Z                                       'Variables are type INTEGER
  17.                                                  '  unless otherwised declared
  18. DECLARE SUB capturecodes (printercode$)          'Get printer codes
  19. DECLARE SUB checkprinter ()                      'Is printer available?
  20. DECLARE SUB clearbox ()                          'Clear monitor window
  21. DECLARE FUNCTION dir$ (filespec$)                'Finds *.ASC files
  22.                                                  'The next SUB draws a window
  23. DECLARE SUB frame (upperrow, leftcolumn, lowerrow, rightcolumn, foreground)
  24. DECLARE SUB getmonitor (monitortype$)            'Is it EGA or CGA?
  25. DECLARE SUB getprinter (printertype$)            'What kind of printer?
  26. DECLARE SUB heading ()                           'Print heading
  27. DECLARE SUB loadarray (monitortype$)             'Set color attributes
  28. DECLARE SUB printnames ()                        'Print file names
  29. DECLARE SUB printpicture (n$)                    'Print picture
  30. DECLARE SUB viewpicture (monitortype$, n$, scrn) 'View picture
  31.  
  32. ON ERROR GOTO enditall                           'Just in case
  33.  
  34. DIM SHARED forecolor(255)                        'Dimension array
  35. DIM SHARED inreg AS regtype, outreg AS regtype   'Define inreg and outreg
  36.                                                  'as regtype
  37.  
  38. DIM SHARED dos                                   'Used with FUNCTION dir$
  39. DIM SHARED dta AS STRING * 44                    'Used with FUNCTION dir$
  40. DIM SHARED findfirst                             'Used with FUNCTION dir$
  41. DIM SHARED findnext                              'Used with FUNCTION dir$
  42. DIM SHARED null$                                 'Used with FUNCTION dir$
  43. DIM SHARED regs AS regtypex                      'Used with FUNCTION dir$
  44. DIM SHARED setdta                                'Used with FUNCTION dir$
  45. dos = &H21                                       'Used with FUNCTION dir$
  46. findfirst = &H4E00                               'Used with FUNCTION dir$
  47. findnext = &H4F00                                'Used with FUNCTION dir$
  48. null$ = CHR$(0)                                  'Used with FUNCTION dir$
  49. setdta = &H1A00                                  'Used with FUNCTION dir$
  50.  
  51. COLOR 7, 0                                       'White on black
  52. CLS                                              'Clear screen
  53. CALL getmonitor(monitortype$)                    'Is it EGA or CGA?
  54. CALL loadarray(monitortype$)                     'Set color attributes
  55. CALL getprinter(printertype$)                    'What kind of printer?
  56. CALL printnames                                  'Print file names
  57. DO WHILE n$ <> "DIANE" AND n$ <> "FRANCES" AND n$ <> "OTHER"
  58.     n$ = ""                                      'Initialize file name to null
  59.     IF scrn <> 0 THEN                            'SCREEN mode not 0?
  60.         CLS                                      '  Clear screen
  61.         IF monitortype$ = "C" THEN               '  CGA?
  62.             WIDTH 80, 25                         '    Invoke 80x25 text mode
  63.         END IF                                   '
  64.         SCREEN 0                                 '  Invoke SCREEN mode 0
  65.         scrn = 0                                 '  Set indicator to 0
  66.         CALL frame(4, 12, 21, 66, 13)            '  Draw a window
  67.         CALL heading                             '  Print heading
  68.         CALL printnames                          '  Print file names
  69.     ELSE                                         'SCREEN mode is 0
  70.         LOCATE 19, 13, 0                         '  Position cursor
  71.         PRINT SPACE$(52);                        '  Clear line
  72.     END IF                                       '
  73.     COLOR 15                                     'Bright white
  74.     LOCATE 19, 27, 1                             'Position cursor
  75.     PRINT "Name of picture? ";                   'Ask user for file name
  76.     COLOR 13                                     'Bright magenta
  77.     LINE INPUT ; ""; n$                          'Null prompt
  78.     IF n$ = "" THEN                              'File name null?
  79.         EXIT DO                                  '  T-T-That's all folks
  80.     ELSE                                         'File name not null
  81.         n$ = UCASE$(n$)                          '  Convert name to upper case
  82.     END IF                                       '
  83.     IF n$ = "DIANE" OR n$ = "FRANCES" OR n$ = "OTHER" THEN
  84.         CLOSE                                    'CLOSE any open files
  85.         OPEN n$ + ".ASC" FOR INPUT AS 1          'OPEN selected file
  86.         IF printertype$ <> "N" THEN              'Printer selected?
  87.             LOCATE 19, 13, 0                     '  Position cursor
  88.             PRINT SPACE$(52);                    '  Clear line
  89.             LOCATE 19, 29, 1                     '  Position cursor
  90.             COLOR 15                             '  Bright white
  91.             PRINT "Print or View [P/V]? ";       '  Print it or display it?
  92.             selection$ = ""                      '  Initialize to null
  93.             WHILE selection$ <> "P" AND selection$ <> "V" 'Wait for P or V
  94.                 selection$ = UCASE$(INKEY$)      '    Make it upper case
  95.             WEND                                 '  Got it
  96.             PRINT selection$;                    '  Show user
  97.             IF selection$ = "P" THEN             '  Print it?
  98.                 CALL printpicture(n$)            '    Print picture
  99.             ELSE                                 '  View it?
  100.                 CALL viewpicture(monitortype$, n$, scrn)'View picture
  101.             END IF                               '
  102.         ELSE                                     'No printer selected
  103.             CALL viewpicture(monitortype$, n$, scrn)'View picture
  104.         END IF                                   '
  105.     END IF                                       '
  106.     n$ = ""                                      'Initialize file name to null
  107. LOOP                                             '
  108.  
  109. enditall:                                        'Just in case
  110. IF scrn <> 0 THEN                                'SCREEN mode not 0?
  111.     SCREEN 0                                     '  Set SCREEN mode to 0
  112.     COLOR 7, 0                                   '  White on black
  113.     CLS                                          '  Clear screen
  114. ELSE                                             'SCREEN mode 0
  115.     LOCATE 19, 13, 0                             '  Position cursor
  116.     PRINT SPACE$(52);                            '  Clear line
  117. END IF                                           '
  118. COLOR 31, 0                                      'Blink bright white on black
  119. SELECT CASE ERR                                  'Any errors?
  120.     CASE 0                                       '  No?
  121.         SELECT CASE printertype$                 '    What type of printer?
  122.             CASE "C"                             '      Custom?
  123.                 printercode$ = ""                '        Initialize to null
  124.                 CALL clearbox                    '        Clear monitor window
  125.                 LOCATE 12, 21, 0                 '        Position cursor
  126.                 COLOR 14                         '        Bright yellow
  127.                 PRINT "Enter the numeric ASCII value of each"
  128.                 LOCATE 13, 20                    '        Position cursor
  129.                 PRINT "character you want sent to your printer."
  130.                 LOCATE 14, 22                    '        Position cursor
  131.                 PRINT "Press the RETURN key after each one."
  132.                 LOCATE 16, 27